Aminet 6/Aminet 6 - June 1995.iso/Aminet/gfx/misc/CatMake124.lha/CatMake.rexx

OS/2 REXX Batch file | 1995-02-13 | 46.5 KB | 1,351 lines

/***********************************/
/* Make one or more catalog-pic(s) */
/* written by Rodja Adolph in 1993 */
/* SHAREWARE with 10$ fee          */
/* Contact me under :              */
/* EMail: [e-mail]  */
/* Anything else is mentioned in   */
/* the docfile you should already  */
/* have read...                    */
/*                                 */
/* THIS text isnt the doc :)       */
/***********************************/
CALL TRACE("o")                   /* trace off */
/* CALL TRACE("i") */
CMVersion='V1.24'                 /* Version */
NeedVersion='2.0'                 /* Configfile-Version needed at least */

WeLaunched=0
Shuffle="NO"
ArgHeader=0
Debug=0
MFRMode=0                          /* Set to 0 and try Multiselect of files  */
                                   /* If it works then keep 0.If not and you */
                                   /* DO have MFR in c:,then set to 1        */
                                   /* Somehow obselete now...But still here..*/

PARSE ARG CatBase "," ERGo "," WildCard "," AHeader "," PrefsFile "," FileData
IF CatBase~="" THEN DO
 Arguments=1
 useD=1
 dum1=LASTPOS('/',CatBase)
 ERGo=UPPER(ERGo)
 IF dum1~=0 THEN thedir=LEFT(CatBase,dum1)
            ELSE DO
                  dum1=POS(':',CatBase)
                  IF dum1~=0 THEN thedir=LEFT(CatBase,dum1)
                             ELSE thedir='SYS:'
                 END
 dirm=UPPER(WORD(FileData,1))
 FileData=DELWORD(FileData,1,1)
 IF dirm="WHOLE" THEN thedir=FileData
                 ELSE DO
                       i="-1"
                       DO WHILE INDEX(FileData,'"')~=0
                        i=i+1
                        PARSE VAR FileData '"' fl.i '"' FileData
                       END
                       fl.count=i+1
                      END
 IF AHeader~="" THEN DO
  AddHeader="YES"
  HeaderString=AHeader
  ArgHeader=1
 END
END
ELSE DO
 Arguments=0
 PrefsFile="ENVARC:CatMakeAdPro.prefs"
END

IF ~SHOW('Ports','ADPro') THEN DO
 SAY "Trying to run AdPro..."
 IF ~OPEN(file,"T:LaunchAdPro.bat","W") THEN EXIT 20
 CALL WRITELN(file,"Stack 4096")
 CALL WRITELN(file,"RUN ADPro:ADPro")
 CALL CLOSE(file)
 ADDRESS COMMAND "Execute T:LaunchAdPro.bat"
 ADDRESS COMMAND "Delete >NIL: T:LaunchAdPro.bat"
 ADDRESS COMMAND "WaitForPort ADPro"
 IF ~SHOW('Ports','ADPro') THEN DO
  SAY "AdPro not found! EXITING!"
  EXIT 20
 END
 ELSE WeLaunched=1
END

ADDRESS "ADPro"                    /* Addressing Host */
OPTIONS RESULTS
SIGNAL ON BREAK_C                  /* Trap on errors and breaks */
SIGNAL ON BREAK_D
SIGNAL ON SYNTAX

WindowOpen=0
NL='0a'x                           /* Newline-Code */
LUP = '1b'x||'M'                   /* LineUp-Code for CON: */
AddedHeader=0
24Bit=16777216                     /* Just for nicer textoutput */
8BitGrey="256G"
DelList.0=0
PPList.0=0

IF ~SHOW('Libraries','rexxsupport.library') THEN DO
 IF ~ADDLIB('rexxsupport.library',0,-30,0) THEN CALL ERR("Couldn't allocate rexxsupport.library!"||NL||"File not found?!")
END

IF ~SHOW('Libraries','rexxtricks.library') THEN DO
 IF ~ADDLIB('rexxtricks.library',0,-30,0) THEN CALL ERR("Couldn't allocate rexxtricks.library!"||NL||"File not found?!")
END

LFORMAT                            /* Get current Loader */
OldLoader=adpro_result

SFORMAT                            /* Get current Saver */
OldSaver=adpro_result

/*
SCREEN_TYPE                        /* Get current Screentype */
SType=adpro_result
*/

VERSION                            /* Check for version if ListViews possible */
IF adpro_result>="ADPro 2.3.0" THEN Up2Date=1
                               ELSE Up2Date=0

IF Up2Date THEN DO                 /* Build default Listview-Lists */
 GETLIST Colors
 PARSE VAR AdPro_Result '"' . '" ' ColorList
 GETLIST Savers
 PARSE VAR AdPro_Result '"' . '" ' SaverList
 TileList='3x2 3x3 4x3 4x4 5x4 5x5 6x5 6x6 Custom Auto'
END

IF OPEN(Prefs,PrefsFile,"R") THEN DO /* Check for PrefsFile */
 PrefsVersion=SUBSTR(WORD(READLN(Prefs),2),2)
 IF NeedVersion>PrefsVersion | "9.0"<PrefsVersion THEN DO
  IF Shuffle="YES" THEN ADPRO_TO_FRONT                      /* Screen2Front */
  OKAY2 'Prefs-File is not Up2Date !'||NL||' Version needed : '||NeedVersion||NL||' Version found  : '||PrefsVersion||NL||'Use the Built-In defaults?'
  IF rc=0 THEN EXIT
          ELSE DO
                zzz=CLOSE(Prefs)
                CALL SetDefs
               END
 END
 DO i=1 TO 4
  zzz=READLN(Prefs)
 END
 TextRender=UPPER(WORD(READLN(Prefs),3)) /* Load settings */
 StripExt=UPPER(WORD(READLN(Prefs),3))
 FName=WORD(READLN(Prefs),3)
 FSize=WORD(READLN(Prefs),3)
 FType=UPPER(WORD(READLN(Prefs),3))
 TextR=WORD(READLN(Prefs),3)
 TextG=WORD(READLN(Prefs),3)
 TextB=WORD(READLN(Prefs),3)
 Sizing=UPPER(WORD(READLN(Prefs),3))
 F2Name=WORD(READLN(Prefs),3)
 F2Size=WORD(READLN(Prefs),3)
 F2Type=UPPER(WORD(READLN(Prefs),3))
 SizeR=WORD(READLN(Prefs),3)
 SizeG=WORD(READLN(Prefs),3)
 SizeB=WORD(READLN(Prefs),3)
 Seperate=UPPER(WORD(READLN(Prefs),3))
 IF ArgHeader=0 THEN AddHeader=UPPER(WORD(READLN(Prefs),3))
                ELSE CALL READLN(Prefs)
 HeaderName=WORD(READLN(Prefs),3)
 HeaderSize=WORD(READLN(Prefs),3)
 HeaderType=UPPER(WORD(READLN(Prefs),3))
 HeaderEmbossDirection=UPPER(WORD(READLN(Prefs),3))
 HeaderEmbossAmount=WORD(READLN(Prefs),3)
 HeaderStyle=WORD(READLN(Prefs),3)
 HeaderOffset=WORD(READLN(Prefs),3)
 CenterHeader=UPPER(WORD(READLN(Prefs),3))
 HeaderR=WORD(READLN(Prefs),3)
 HeaderG=WORD(READLN(Prefs),3)
 HeaderB=WORD(READLN(Prefs),3)
 IF ArgHeader=0 THEN HeaderString=SUBSTR(READLN(Prefs),19)
                ELSE CALL READLN(Prefs)
 zzz=READLN(Prefs)
 zzz=READLN(Prefs)
 IF ~Arguments THEN dirm=UPPER(WORD(READLN(Prefs),3))
               ELSE zzz=READLN(Prefs)
 Sorting=UPPER(WORD(READLN(Prefs),3))
 SaveOnError=UPPER(WORD(READLN(Prefs),3))
 ProcOnErr=UPPER(WORD(READLN(Prefs),3))
 ProcOnStr=SUBSTR(READLN(Prefs),19)
 CharStripping=UPPER(WORD(READLN(Prefs),3))
 PARSE VAR CharStripping CharMain "+" CharExtension
 TDir=SUBSTR(READLN(Prefs),19)
 IF RIGHT(TDir,1)~=':' & RIGHT(TDir,1)~='/' THEN TDir=TDir||'/'
 IF ~Arguments THEN WildCard=WORD(READLN(Prefs),3)
               ELSE zzz=READLN(Prefs)
 ExamineFiles=UPPER(WORD(READLN(Prefs),3))
 ExamineNames=UPPER(WORD(READLN(Prefs),3))
 Shuffle=UPPER(WORD(READLN(Prefs),3))
 zzz=READLN(Prefs)
 zzz=READLN(Prefs)
 CatBasis=WORD(READLN(Prefs),3)
 CatForm=UPPER(WORD(READLN(Prefs),3))
 AddSaver=UPPER(WORD(READLN(Prefs),3))
 CatMode=UPPER(WORD(READLN(Prefs),3))
 Mode=UPPER(WORD(READLN(Prefs),3))
 SizeMode=UPPER(WORD(READLN(Prefs),3))
 Cols=WORD(READLN(Prefs),3)
 PWI=WORD(READLN(Prefs),3)
 PHE=WORD(READLN(Prefs),3)
 PHEBack=PHE
 TWI=WORD(READLN(Prefs),3)
 THI=WORD(READLN(Prefs),3)
 TMode=WORD(READLN(Prefs),3)
 BorderR=WORD(READLN(Prefs),3)
 BorderG=WORD(READLN(Prefs),3)
 BorderB=WORD(READLN(Prefs),3)
 MixFactor=WORD(READLN(Prefs),3)
 MixR=WORD(READLN(Prefs),3)
 MixG=WORD(READLN(Prefs),3)
 MixB=WORD(READLN(Prefs),3)
 Back1R=WORD(READLN(Prefs),3)
 Back1G=WORD(READLN(Prefs),3)
 Back1B=WORD(READLN(Prefs),3)
 Back2R=WORD(READLN(Prefs),3)
 Back2G=WORD(READLN(Prefs),3)
 Back2B=WORD(READLN(Prefs),3)
 Back3R=WORD(READLN(Prefs),3)
 Back3G=WORD(READLN(Prefs),3)
 Back3B=WORD(READLN(Prefs),3)
 Back4R=WORD(READLN(Prefs),3)
 Back4G=WORD(READLN(Prefs),3)
 Back4B=WORD(READLN(Prefs),3)
 Back2Pos=WORD(READLN(Prefs),3)
 BackDir=UPPER(WORD(READLN(Prefs),3))
 zzz=READLN(Prefs)
 zzz=READLN(Prefs)
 MakeAlt=UPPER(WORD(READLN(Prefs),3))
 Colors=WORD(READLN(Prefs),3)
 SForm=UPPER(WORD(READLN(Prefs),3))
 SMode=UPPER(WORD(READLN(Prefs),3))
 Extension=WORD(READLN(Prefs),3)
 zzz=CLOSE(Prefs)
END
ELSE DO
 zzz=CLOSE(Prefs)
 CALL SetDefs                           /* No File -> defaults */
END

MAIN:

TileList='"'||TMode||'" '||TileList /* Complete with TilingMode */
IF FSize>F2Size THEN FSizeMax=FSize
                ELSE FSizeMax=F2Size
IF Sizing="BOTTOM" THEN FSizeMax=FSize+F2Size+2


IF ~Arguments THEN DO
 IF Shuffle="YES" THEN ADPRO_TO_FRONT     /* Screen2Front */
 OKAY2 'Do you want to use the'||NL||'   entire defaults?'||NL||'OK=Whole Cancel=Partial'
 if rc=0 then useD=0
         else useD=1
END

IF useD=0 THEN CALL AskSettings          /* Ask for all the settings... */

IF ~Arguments THEN DO
 /* Get files to work on */
 fl.count=0                       /* FileNames-Array with fl.count holding the */
                                    /* number of entries                         */
 IF dirm='MULTI' THEN DO
  IF MFRMode=1 THEN DO
   /* Use MFR to select some files */
   ADPRO_TO_BACK
   ADDRESS COMMAND 'C:MFR >'||TDir||'Files TITLE="Select pictures to catalogize" MULTI'
   IF ~OPEN(File,TDir||'Files','R') THEN CALL ERR('Couldnt open MFR-Output file!')
   i="-1"
   /* Read selected files from temporary file and add to FileList fl. */
   DO WHILE ~EOF(file)
    line=READLN(file)
    IF LENGTH(line)=0 THEN LEAVE
    i=i+1
    fl.i=line
    DO WHILE index(fl.i,"//")~=0
     fl.i=DELSTR(fl.i,index(fl.i,"//"),1)
    END
   END
   fl.count=i+1                       /* Store number of entries */
   ab=CLOSE(file)
   IF Shuffle="YES" THEN ADPRO_TO_FRONT
   IF fl.count=0 THEN CALL ERR('No Files found')
  END
  ELSE DO
   /* Use AdPro for multiselecting */
   GETFILES '"Select pictures to catalogize"'
   IF rc~=0 THEN CALL ERR('')
   fltemp=adpro_result /* Long string with filenames like "a" "b" "c" */
   IF WORDS(fltemp)=1 THEN fltemp='"'||fltemp||'"'
   i="-1"
   DO WHILE INDEX(fltemp,'"')~=0 /* Repeat until no " can be found */
    i=i+1
    /* Get the next filename out of fltemp and also remove it from fltemp afterwards */
    PARSE VAR fltemp '"' fl.i '"' fltemp
   END
   fl.count=i
   IF Shuffle="YES" THEN ADPRO_TO_FRONT
   IF fl.count=0 THEN CALL ERR('No Files found')
  END
  thedir=PATHPART(fl.0)
  IF thedir="" THEN thedir='SYS:'
 END
END

IF dirm="WHOLE" THEN DO
 /* Whole-Dir-Mode */
 IF ~Arguments THEN DO
  GETDIR "'Work on which dir?'"
  IF rc~=0 THEN CALL ERR('')
  thedir=adpro_result               /* Our working-directory */
 END

 IF RIGHT(thedir,1)~=':' & RIGHT(thedir,1)~='/' THEN thedir=thedir||'/'

 /* Get a filelist with # seperators like a#b#c */
 fltemp=SHOWDIR(thedir,'File','#')
 IF ~Arguments & Shuffle="YES" THEN ADPRO_TO_FRONT /* Perhaps some Reqpatcher sent us to front */
 IF fltemp='' THEN CALL err('No files found!')
 i=0
 /* Get actual files */
 DO WHILE INDEX(fltemp,'#')~=0
  fl.i=LEFT(fltemp,INDEX(fltemp,'#')-1)
  fltemp=DELSTR(fltemp,1,INDEX(fltemp,'#'))
  i=i+1
 END
 fl.i=fltemp /* We still have one filename in fltemp */
 fl.count=i
END

IF ~Arguments THEN DO
 /* Wildcard-Queries */
 OKAY2 'Do you want to use a wildcard to filter files?'
 IF rc=0 THEN Wildcard='OFF'
         ELSE DO
               GETSTRING '"Enter wildcard (use 1-2 * and perhaps a ~)"' Wildcard
               IF rc~=0 THEN CALL ERR('')
               Wildcard=ADPro_Result
               IF INDEX(Wildcard,"*")=0 THEN Wildcard="*"
              END
END

/* Sorting-Mode */
IF ~UseD & Up2Date THEN DO
 IF Sorting="ALPHA" THEN DO
                          OKS="Custom"
                          OKS2="CUSTOM"
                          CANS="Alpha"
                          CANS2="ALPHA"
                         END
                    ELSE DO
                          OKS="Alpha "
                          OKS2="ALPHA"
                          CANS="Custom"
                          CANS2="CUSTOM"
                         END
 OKAY2 '"Use alphabetical or custom sorting?'||NL||'    OK='||OKS||'      Cancel='||CANS||'"'
 IF rc=0 THEN Sorting=CANS2
         ELSE Sorting=OKS2
END
IF ~Up2Date THEN Sorting="ALPHA"

IF LEFT(TheDir,1)='"' THEN TheDir=DELSTR(TheDir,1,1)

IF ~Arguments THEN DO
 /* Get basename for catalogs */
 GETFILE "'Enter CatalogBaseName'" '"'||TheDir||'"' CatBasis
 IF rc~=0 THEN CALL ERR('')
 CatBase=ADPro_Result
END

/* Get path+name seperately for catalogs */
 CatBasis=FILEPART(CatBase)
 IF CatBasis="" THEN CatBasis='_Catalog.'
 CatDir=PATHPART(CatBase)
 IF CatDir="" THEN CatDir="SYS:"

/* Apply Wildcard */
IF Wildcard~="OFF" & Wildcard~="*" & Wildcard~="#?" & fl.count>0 & fl.count~="FL.COUNT" THEN DO
 Fl0Back=fl.count
 DO i=0 TO fl.count
  IF ~MATCHPATTERN(fl.i,Wildcard) THEN DO            /* Remove entry */
   IF fl.count>i THEN DO
    DO j=i TO fl.count-1
     k=j+1
     fl.j=fl.k
    END
   END
   fl.count=fl.count-1
   i=i-1
  END
  IF i>=fl.count THEN LEAVE i
 END
 SAY "Removed "||Fl0Back-fl.count||" entries due to wildcarding"
END

IF fl.count="-1" THEN DO
 IF ~arguments THEN CALL ERR("No files left after wildcarding!")
 EXIT 5
END

/* Now possibly check for archives...*/
DO i=0 TO fl.count
 IF dirm='MULTI' THEN flcat=fl.i
                 ELSE flcat=thedir||fl.i
 IF ExamineNames="YES" | ExamineFiles="YES" THEN DO  /* Check for LhA/Lzh/pp files */
  SELECT
   WHEN ExamineNames="YES" & (UPPER(RIGHT(flcat,4))=".LZH" | UPPER(RIGHT(flcat,4))=".LHA") THEN DO
    flcat=UnPack("LHA",flcat,thedir)
    IF dirm='MULTI' THEN fl.i=thedir||flcat
                    ELSE fl.i=flcat
   END
   WHEN ExamineNames="YES" & UPPER(RIGHT(flcat,3))=".PP" THEN CALL UnPack("PP",flcat,thedir)
   WHEN ExamineFiles="YES" & ExamineFile(flcat)="LHA" THEN DO
    flcat=UnPack("LHA",flcat,thedir)
    IF dirm='MULTI' THEN fl.i=thedir||flcat
                    ELSE fl.i=flcat
   END
   WHEN ExamineFiles="YES" & ExamineFile(flcat)="PP" THEN CALL UnPack("PP",flcat,thedir)
   OTHERWISE NOP
  END
 END
END

/* Now sort the filelist */
IF fl.count>1 THEN DO
 fl.count=fl.count+1
 zz=QSORT("fl")
 fl.count=fl.count-1
END

/* Now checking if catalogs exist in the catalogdir and ask what to do */
/* Catalogs are identified from the current basename...                */
 IF ~Arguments THEN DO
  AlreadyAsked=0
  OverFlag=1
  CAPFL=SHOWDIR(CatDir,'File')
  IF WORDS(CAPFL)>0 THEN DO
   DO i=1 TO WORDS(CAPFL)
    zzz=WORD(CAPFL,i)
    IF UPPER(LEFT(zzz,LENGTH(catbasis)))=UPPER(catbasis) THEN zFlag=1
                                                         ELSE zFlag=0
    IF zFlag THEN DO
     /* Found existing catalog */
     IF ~AlreadyAsked & zFlag THEN DO
      OKAY2 '"   Overwrite or rename'||NL||'    existing catalog ?'||NL||'OK=Overwrite Cancel=Rename"'
      OverFlag=rc
      AlreadyAsked=1
     END
     IF RIGHT(catdir,1)~=":" & RIGHT(catdir,1)~="/" THEN zzz="/"||zzz
     IF ~OverFlag THEN ADDRESS COMMAND 'rename "'||catdir||zzz||'" "'||catdir||zzz||'.bak"'
    END
   END
  END
 END
 IF RIGHT(catdir,1)~=":" & RIGHT(catdir,1)~="/" THEN dira=catdir||"/"
                                                ELSE dira=catdir
 IF RIGHT(thedir,1)~=":" & RIGHT(thedir,1)~="/" THEN dirb=thedir||"/"
                                                ELSE dirb=thedir
 IF dira=dirb THEN DO
  /* We must also delete this entry from the FileList */
  DO j=0 TO fl.count
    IF INDEX(fl.j,catbasis)~=0 THEN DO                 /* Delete entry */
                                     IF fl.count>j THEN DO
                                      DO k=j TO fl.count-1
                                       l=k+1
                                       fl.k=fl.l
                                      END
                                      j=j-1
                                     END
                                     fl.count=fl.count-1
                                    END
  END
 END

/* The Listview for the tiling */
IF Up2Date | Arguments THEN DO
 IF ~Arguments THEN DO
  ListView '"Tiling for '||fl.count+1||' pics"' 10 ITEMS TileList
  IF rc>1 THEN CALL ERR('')
  PARSE VAR adpro_result '"' ERGo '"' .
 END
 ERGo=UPPER(ERGo)
 IF ERGo~='AUTO' & ERGo~='CUSTOM' THEN PARSE VAR ERGo TWI 'X' THI .
 ELSE DO
  IF ERGo='CUSTOM' THEN CALL QueryTiling
  IF ERGo='AUTO' THEN DO
   /* Automode to fit all pics on one catalog */
   TWI=0
   THI=0
   dum1=1
   DO UNTIL TWI*THI>=fl.count+1
    IF dum1 THEN DO
                  TWI=TWI+1
                  dum1=0
                 END
            ELSE DO
                  THI=THI+1
                  dum1=1
                 END
   END
  END
 END
END
ELSE CALL QueryTiling

/* Size of each tile in pixels */
IF AddHeader='YES' THEN PHE=PHE-HeaderSize-2
TWID=TRUNC((PWI-TWI-1)/TWI)
THEI=TRUNC((PHE-THI-1)/THI)

/* Perhaps do a custom-sorting now */
IF Sorting='CUSTOM' & Up2Date THEN DO
 FLA=''
 DO i=0 to fl.count
  FLA=FLA||'"'||FILEPART(fl.i)||'" '
 END
 /* FLA holds now all filenames (NO paths!) in quotes */
 i=0
 FLABack=FLA
 DO UNTIL WORDS(FLABack)=1
  ListView '"Next in custom order?"' 10 ITEMS FString||' '||FLABack
  IF rc>1 THEN CALL ERR('Cancelled by user')
  PARSE VAR adpro_result '"' ERG '"' .
  idc=FIND(FLA,'"'||ERG||'"')
  idc2=FIND(FLABack,'"'||ERG||'"')
  IF idc=0 THEN CALL ERR('Internal Error -5')
  i=i+1
  flb.i=fl.idc
  FLABack=DELWORD(FLABack,idc2,WORDS(ERG))
 END
 i=i+1
 idc=FIND(FLA,SUBWORD(FLABack,1,WORDS(FLABack)))
 flb.i=fl.idc
 DO i=0 to fl.count
  fl.i=flb.i
 END
END
ELSE DO
 IF Sorting='CUSTOM' & ~Up2Date THEN OKAY1 'Custom sorting needs AdPro >=2.30 !'
END

cats=1    /* Number of catalogs */
k=0

/* Setup catalogs with whole filenames (incl. path) */
IF fl.count=0 THEN CALL ERR('No files found to catalogize ?!')
DO i=0 TO fl.count
  k=k+1
  IF dirm='MULTI' THEN cat.cats.k=fl.i
                  ELSE cat.cats.k=thedir||fl.i
  cat.cats.0=k
  IF k=TWI*THI THEN DO
                     k=0
                     cats=cats+1
                     cat.cats.0=0
                    END
END

IF cat.cats.0=0 THEN cats=cats-1

/* First text-output... */
IF ~Arguments THEN ADPRO_TO_BACK
/* Arrange a grammar-correct string ;-) */
IF cats>1 THEN dum1='s each'
          ELSE dum1=''
IF cat.1.0>1 THEN dum2='s'
             ELSE dum2=''
/* Open window for Text-Output with special Window-Header */
IF ~open(CON,'con:15/15/500/200/CatMake '||CMVersion||' : Processing '||cats||' catalog'||dum1||' with '||cat.1.0||' tile'||dum2||'!/SCREEN ADPro','W') THEN CALL ERR('Error opening output-window!')
WindowOpen=1

/* abc serves as dummy variable... */
zzz=WriteLn(CON,'')
zzz=WriteLn(CON,'')
DO i=1 TO cats                       /********** Make catalog(s) **********/
 reallyloaded=0
 LFORMAT 'UNIVERSAL'
 SFORMAT 'IFF'
 zzz=WriteLn(CON,LUP||'                                                                       ')
 zzz=WriteLn(CON,LUP||'Processing catalog #'||i||copies(' ',length(cats)-length(i))||' :')
 zzz=WriteLn(CON,'')
 DO j=1 TO cat.i.0                   /* Make thumbnails */
  zzz=WriteLn(CON,LUP||'                                                                       ')
  TXString.j=FILEPART(cat.i.j)
  dum1= cat.1.0*(cats-i-1)
  IF cats-i<2 THEN dum1=0
  CatToGo=cat.i.0-j + cat.cats.0 + dum1
  IF i=cats THEN CatToGo=cat.i.0-j
  IF CatToGo=0 THEN CatToGo="finished)"
               ELSE CatToGo=RIGHT(CatToGo,LENGTH(cats*cat.1.0))||" to go)"

  zzz=WriteLn(CON,LUP||' Processing entry #'||j||RIGHT('',LENGTH(cat.i.0))||' (then '||CatToGo||' : '||TXString.j)
  zzz=WriteLn(CON,'                                                                       ')
  zzz=WriteLn(CON,LUP||'  Loading...')
  ADDRESS REXX "REXX:CatMakePrePicLoad.rexx" cat.i.j
  LOAD '"'||cat.i.j||'"'
  rca=rc
  ADDRESS REXX "REXX:CatMakePostPicLoad.rexx" cat.i.j
  IF rca=0 | (rca~=0 & ProcOnErr='YES') THEN DO
   ActWid=TWID
   ActHei=THEI
   IF Seperate='YES' & TextRender="YES" THEN XScale=FSizeMax
                                        ELSE XScale=0
   IF rca~=0 THEN DO                 /* Create error-pic */
    LFORMAT 'BACKDROP'
    IF mode="COLOR" THEN LOAD "X" TWID THEI-XScale "COLOR" Back1R Back1G Back1B Back2R Back2G Back2B Back3R Back3G Back3B Back4R Back4G Back4B
                    ELSE LOAD "X" TWID THEI-XScale "GRAY" Back1R Back1G Back1B Back2R Back2G Back2B Back3R Back3G Back3B Back4R Back4G Back4B
    Operator "TEXT_VISUAL" FONT_TYPE HeaderType FONT_NAME HeaderName SET_FONT_SIZE HeaderSize RENDER_TYPE MIX SET_EMBOSS HeaderEmbossAmount,
                           EMBOSS_DIRECTION HeaderEmbossDirection SET_TEXT_STYLE HeaderStyle SET_BLUR '-1' SET_COLORS HeaderR HeaderG HeaderB,
                           SET_SATURATION 100 SET_TEXT_STYLE 0 SET_TINT 0 SET_TRACKING 0 SET_RENDER 100,
                           STRING '"'||ProcOnStr||'"' TEXT_HANDLE LEFT CENTER_XOFFSET CENTER_YOFFSET DRAW
    LFORMAT 'UNIVERSAL'
   END
   XSIZE
   XSz.j=adpro_result
   YSIZE
   YSz.j=adpro_result
   IMAGE_TYPE
   IType=AdPro_Result
   IF INDEX(IType,'BITPLANE')~=0 THEN DO
    RENDER_TYPE
    rest=AdPro_Result
    IF AdPro_Result~='EHB' & AdPro_Result~='HAM' & AdPro_Result~='CUST' & AdPro_Result~='HAM8' THEN DO
     CDepth=0
     DO UNTIL rest=1
      CDepth=CDepth+1
      rest=rest/2
     END
    END
    ELSE CDepth=rest
   END
   ELSE DO
    IF INDEX(IType,'COLOR')~=0 THEN CDepth=24
                               ELSE CDepth='8BW'
   END
   ColorDepth.j=CDepth
   IF INDEX(IType,'COLOR')=0 & INDEX(IType,'GRAY')=0 THEN DO
   zzz=WriteLn(CON,LUP||'  Converting to RAW-Data...')
    OPERATOR 'RENDER_TO_RAW'
    IF rc~=0 THEN CALL ERR('Error while rendering'||NL||'to Raw (not enough mem?)')
   END
   IF MakeAlt='YES' THEN DO                /* Convert to alternate image */
    bb=''
    zzz=WriteLn(CON,LUP||'  Building alternate representation...')
    ADDRESS REXX "REXX:CatMakePreAltProcess.rexx"
    IF upper(SMode)~='RAW' THEN DO
     zzz=WriteLn(CON,'                                                                       ')
     zzz=WriteLn(CON,LUP||'   Rendering to '||Colors||' colors...')
     render_type Colors
     /*SCREEN_TYPE SType*/
     execute
     bb=LUP
    END

    IF LEFT(Extension,1)='.' THEN Extension=SUBSTR(Extension,2)
    IF INDEX(cat.i.j,'.')~=0 THEN fileo=LEFT(cat.i.j,LASTPOS('.',cat.i.j))||Extension
                             ELSE fileo=cat.i.j||'.'||Extension
    zzz=WRITELN(CON,bb||'                                                                       ')
    zzz=WRITELN(CON,LUP||'   Saving alternate image as '||SForm||'...')
    SFORMAT SForm
    SAVE '"'||fileo||'"' SMode
    IF rc~=0 THEN DO
     okay1 'Error while saving'||NL||'alternate image as :'||fileo
    END
    SFORMAT IFF
    zzz=WriteLn(CON,LUP||'                                                                    ')
    zzz=WriteLn(CON,LUP||LUP||'                                                                    ')
    zzz=WriteLn(CON,LUP)
   END

   IF SizeMode='ABSOLUTE' THEN DO
                                zzz=WriteLn(CON,LUP||'                                                                       ')
                                zzz=WriteLn(CON,LUP||'  Scaling to '||TWID||' x '||THEI||'...')
                                ABS_SCALE ActWid ActHei-XScale
                               END
                          ELSE DO
                                zzz=WriteLn(CON,LUP||'                                                                       ')
                                IF Seperate='YES' THEN THII=THEI-XScale
                                                  ELSE THII=THEI
                                PctA=XSz.j/TWID
                                IF YSz.j/PctA>THII THEN DO
                                 PctA=YSz.j/THII
                                END
                                NewX=TRUNC(XSz.j/PctA)
                                NewY=TRUNC(YSz.j/PctA)
                                zzz=WriteLn(CON,LUP||'  Scaling to '||NewX||' x '||NewY||'...')
                                ABS_SCALE NewX NewY
                                ActWid=NewX
                                ActHei=NewY
                               END
   zzz=WriteLn(CON,LUP||'                                                                       ')
   zzz=WriteLn(CON,LUP||'  Adding Textline...')

   image_type
   IF INDEX(adpro_result,'GRAY')~=0 & Mode~="BLACKWHITE" THEN OPERATOR "GRAY_TO_COLOR"
                                                         ELSE IF Mode="BLACKWHITE" THEN OPERATOR "COLOR_TO_GRAY" 3333 3334 3333

   zzz=WriteLn(CON,LUP||'                                                                       ')
   zzz=WriteLn(CON,LUP||'  Saving temporary thumbnail...')
   SAVE TDir||'CAT.'||j RAW
   if j>1 THEN XtraString=NL||'       Volume full ?!'
          ELSE XtraString=NL||'TempDir-Path incorrect ?!'
   if rc~=0 then CALL ERR('Error while saving'||NL||'temporary thumbnail!'||XtraString)
   if j<cat.i.0 then zzz=WriteLn(CON,LUP||LUP)
   reallyloaded=reallyloaded+1
  end
  else reallyloaded=reallyloaded-1
 end

 IF reallyloaded>0 THEN DO
  zzz=WriteLn(CON,LUP||'                                                                       ')
  zzz=WriteLn(CON,LUP||LUP||'                                                                       ')
  zzz=WriteLn(CON,LUP||' Creating blank catalog...')
  LFORMAT "BACKDROP"
  IF Mode="BLACKWHITE" THEN LOAD "X" PWI PHE "GRAY" Back1R Back1G Back1B Back2R Back2G Back2B Back3R Back3G Back3B Back4R Back4G Back4B
                       ELSE LOAD "X" PWI PHE "COLOR" Back1R Back1G Back1B Back2R Back2G Back2B Back3R Back3G Back3B Back4R Back4G Back4B
  IF rc=10 THEN CALL ERR('"   Error while creating'||NL||'    catalog backdrop !'||NL||'(Probably not enough mem)"')

  LFORMAT 'IFF'

  LST=' '
  DO j=1 to THI-1                     /* The wrapped tiles...*/
   LST=LST||TWI*j+1||' '
  END

  cx=1
  cy=1
  zzz=WriteLn(CON,LUP||'                                                                        ')
  IF cat.i.0>1 THEN dum1='ies'
               ELSE dum1='y'
  zzz=WriteLn(CON,LUP||' Composing '||cat.i.0||' entr'||dum1||'...')
  zzz=WriteLn(CON,'')
  DO j=1 TO cat.i.0                   /* Compose thumbnails */
   IF INDEX(LST,' '||j||' ')~=0 THEN DO
                      cy=cy+THEI+1
                      cx=1
                     END
   filename=TDir||'CAT.'||j
   zzz=WriteLn(CON,LUP||'                                                                       ')
   zzz=WriteLn(CON,LUP||'  Loading a thumbnail...')
   IF debug=1 THEN DO
    SAY "    @729 : LOAD "||filename||" "||cx||" "||cy||" 100"
    SAY "           i="||i||"  j="||j
   END
   LOAD filename cx cy 100
   IF rc=10 THEN CALL ERR('Error while loading'||NL||'temporary thumbnail !'||NL||'(Whereas saving was succesful)')
   cx=cx+TWID+1
  END

/*  if mode='BLACKWHITE' then OPERATOR "COLOR_TO_GRAY"  */
  zzz=WriteLn(CON,LUP||'                                                                       ')
  zzz=WriteLn(CON,LUP||'  Drawing rectangles and texts...')
  k=0

  /* Draw some rectangles and text */
  DO y=1 to THI
   IF (y-1)*(THEI+1)+THEI+2>=PHE THEN a=PHE-(y-1)*(THEI+1)-1
                                 ELSE a=THEI+2
   IF TextRender="YES" THEN DO
    IF Seperate="YES" THEN Operator "RECTANGLE" 0 y*(THEI+1)-FSizeMax-1 (TWI-1)*(TWID+1)+TWID+2 FSizeMax+2 1 BorderR BorderG BorderB
                      ELSE Operator "RECTANGLE" 0 y*(THEI+1)-FSizeMax (TWI-1)*(TWID+1)+TWID+2 FSizeMax "-1" MixR MixG MixB MixFactor
   END
   DO x=1 to TWI
    IF (x-1)*(TWID+1)+TWID+2>=PWI THEN b=PWI-(x-1)*(TWID+1)-1
                                  ELSE b=TWID+2
    k=k+1
    IF cat.i.0>=k THEN DO
     IF TextRender="YES" THEN DO
      /* Render the textstrings */
      TXStr=TXString.k
      IF StripExt="YES" THEN DO
                              IF LASTPOS(".",TXStr)~=0 THEN TXStr=LEFT(TXStr,LASTPOS(".",TXStr)-1)
                             END
      IF Sizing="BOTTOM" THEN ExtraSize=F2Size+2
                         ELSE ExtraSize=0
      Operator "TEXT_VISUAL" FONT_TYPE FType FONT_NAME FName SET_FONT_SIZE FSize RENDER_TYPE MIX,
                             EMBOSS_DIRECTION OFF SET_TEXT_STYLE 0 SET_BLUR '-1' SET_COLORS TextR TextG TextB,
                             SET_SATURATION 100 SET_TEXT_STYLE 0 SET_TINT 0 SET_TRACKING 0 SET_RENDER 100,
                             STRING '"'||TXStr||'"' TEXT_HANDLE LEFT SET_XOFFSET (x-1)*(TWID+1)+5 SET_YOFFSET y*(THEI+1)-FSize-ExtraSize DRAW
      IF Sizing='YES' | Sizing='RIGHT' | Sizing="BOTTOM" THEN DO
       TX2Str=XSz.k||'x'||YSz.k||'x'||ColorDepth.k
       IF Sizing='YES' | Sizing='RIGHT' THEN DO
        Operator "TEXT_VISUAL" FONT_TYPE F2Type FONT_NAME F2Name SET_FONT_SIZE F2Size RENDER_TYPE MIX,
                               EMBOSS_DIRECTION OFF SET_TEXT_STYLE 0 SET_BLUR '-1' SET_COLORS SizeR SizeG SizeB,
                               SET_SATURATION 100 SET_TEXT_STYLE 0 SET_TINT 0 SET_TRACKING 0 SET_RENDER 100,
                               STRING TX2Str TEXT_HANDLE RIGHT SET_XOFFSET x*(TWID+1)-5 SET_YOFFSET y*(THEI+1)-F2Size DRAW
       END
       ELSE DO
        Operator "TEXT_VISUAL" FONT_TYPE F2Type FONT_NAME F2Name SET_FONT_SIZE F2Size RENDER_TYPE MIX,
                               EMBOSS_DIRECTION OFF SET_TEXT_STYLE 0 SET_BLUR '-1' SET_COLORS SizeR SizeG SizeB,
                               SET_SATURATION 100 SET_TEXT_STYLE 0 SET_TINT 0 SET_TRACKING 0 SET_RENDER 100,
                               STRING TX2Str TEXT_HANDLE LEFT SET_XOFFSET (x-1)*(TWID+1)+5 SET_YOFFSET y*(THEI+1)-F2Size DRAW
       END
      END
     END
    END
   END
   /* Horizontal rectangles */
   OPERATOR "RECTANGLE" 0 (y-1)*(THEI+1) (TWI-1)*(TWID+1)+TWID+2 a 1 BorderR BorderG BorderB
  END
  /* Vertical rectangles */
  DO x=1 to TWI
   IF (x-1)*(TWID+1)+TWID+2>=PWI THEN b=PWI-(x-1)*(TWID+1)-1
                                 ELSE b=TWID+2
   OPERATOR "RECTANGLE" (x-1)*(TWID+1) 0 b (THI-1)*(THEI+1)+THEI+2 1 BorderR BorderG BorderB
  END
/*      Operator "RECTANGLE" (x-1)*(TWID+1)+3 y*(THEI+1)-FSizeMax b-6 FSizeMax "-1" MixR MixG MixB MixFactor
      IF Seperate="YES" THEN Operator "RECTANGLE" (x-1)*(TWID+1) y*(THEI+1)-FSizeMax-1 b FSizeMax+2 1 BorderR BorderG BorderB
*/

  IF AddHeader='YES' THEN DO
   result=SETCLIP('CatMakeHeader',HeaderString)
   ADDRESS REXX "REXX:CatMakePreAddheader.rexx" i
   HeaderString=GETCLIP('CatMakeHeader')
   result=SETCLIP('CatMakeHeader')
   AddedHeader=1
   SFORMAT "IFF"
   SAVE TDir||"CatMake.Catalog.TMP" RAW
   LFORMAT "BACKDROP"
   IF mode="COLOR" THEN LOAD "X" PWI PHEBack "COLOR" Back1R Back1G Back1B Back2R Back2G Back2B Back3R Back3G Back3B Back4R Back4G Back4B
                   ELSE LOAD "X" PWI PHEBack "GRAY" Back1R Back1G Back1B Back2R Back2G Back2B Back3R Back3G Back3B Back4R Back4G Back4B
   LFORMAT "IFF"
   LOAD TDir||"CatMake.Catalog.TMP" 0 HeaderSize+2 100
   IF CenterHeader="YES" THEN CString='CENTER_XOFFSET'
                         ELSE CString=''
   Operator "TEXT_VISUAL" FONT_TYPE HeaderType FONT_NAME HeaderName SET_FONT_SIZE HeaderSize RENDER_TYPE MIX SET_EMBOSS HeaderEmbossAmount,
                          EMBOSS_DIRECTION HeaderEmbossDirection SET_TEXT_STYLE HeaderStyle SET_BLUR '-1' SET_COLORS HeaderR HeaderG HeaderB,
                          SET_SATURATION 100 SET_TEXT_STYLE 0 SET_TINT 0 SET_TRACKING 0 SET_RENDER 100,
                          STRING '"'||HeaderString||'"' TEXT_HANDLE LEFT SET_XOFFSET HeaderOffset SET_YOFFSET 2 CString DRAW
   OPERATOR "RECTANGLE" 0 0 (x-2)*(TWID+1)+b HeaderSize+3 1 BorderR BorderG BorderB
   ADDRESS COMMAND "C:Delete >NIL: "||TDir||"CatMake.Catalog.TMP"
  END
  zzz=WriteLn(CON,LUP||'                                                                       ')
  if CatMode~='RAW' then do
   zzz=WriteLn(CON,LUP||'  Rendering catalog...')
   RENDER_TYPE Cols
   /*SCREEN_TYPE SType*/
   ADDRESS REXX "REXX:CatMakePreCatRender.rexx" i
   EXECUTE
   zzz=WriteLn(CON,LUP||'                                                                       ')
  end
  zzz=WriteLn(CON,LUP||'  Saving catalog as '||CatForm||' under '||FILEPART(CatBase)||i||'...')
  SFORMAT CatForm
  IF cats=1 THEN IString=''
            ELSE DO
                  IString=i
                  IF AddSaver="YES" THEN IString=IString||'.'
                 END
  IF AddSaver="YES" THEN IString=IString||CatForm
  File=CatBase||IString

  result=SETCLIP('CatMakeCatName',File)
  ADDRESS REXX "REXX:CatMakePreCatSave.rexx" File
  File=GETCLIP('CatMakeCatName')
  result=SETCLIP('CatMakeCatName')

  SAVE '"'||File||'"' CatMode
  ADDRESS REXX "REXX:CatMakePostCatSave.rexx" File
  zzz=WriteLn(CON,LUP||'                                                                       ')
  zzz=WriteLn(CON,LUP||'  Deleting temporary files...')
  ADDRESS COMMAND 'C:Delete >NIL: '||TDir||'CAT.#? QUIET'
  if i<cats then zzz=WriteLn(CON,LUP||LUP||LUP)
 END
END

CatBasis=FILEPART(CatBase)
IF CatBasis="" THEN CatBasis="_Catalog."

/* Save prefs */
SaveData:
IF OPEN(Prefs2,PrefsFile,"W") THEN DO
 zzz=WriteLn(Prefs2,'Version V'||NeedVersion)
 zzz=WriteLn(Prefs2,"  These are the current default settings for R.Adolph's CatalogGenerator")
 zzz=WriteLn(Prefs2,'           written in ARexx for use with The Art Department Pro')
 zzz=WriteLn(Prefs2,'')
 zzz=WriteLn(Prefs2,'FontPrefs')
 zzz=WriteLn(Prefs2,' TextRender     = '||TextRender)
 zzz=WriteLn(Prefs2,' StripExtension = '||StripExt)
 zzz=WriteLn(Prefs2,' Fontname       = '||FName)
 zzz=WriteLn(Prefs2,' Fontsize       = '||FSize)
 zzz=WriteLn(Prefs2,' Fonttype       = '||FType)
 zzz=WriteLn(Prefs2,' TextR          = '||TextR)
 zzz=WriteLn(Prefs2,' TextG          = '||TextG)
 zzz=WriteLn(Prefs2,' TextB          = '||TextB)
 zzz=WriteLn(Prefs2,' Size           = '||Sizing)
 zzz=WriteLn(Prefs2,' Size_Fontname  = '||F2Name)
 zzz=WriteLn(Prefs2,' Size_Fontsize  = '||F2Size)
 zzz=WriteLn(Prefs2,' Size_Fonttype  = '||F2Type)
 zzz=WriteLn(Prefs2,' SizeR          = '||SizeR)
 zzz=WriteLn(Prefs2,' SizeG          = '||SizeG)
 zzz=WriteLn(Prefs2,' SizeB          = '||SizeB)
 zzz=WriteLn(Prefs2,' Seperate       = '||Seperate)
 zzz=WriteLn(Prefs2,' Header         = '||AddHeader)
 zzz=WriteLn(Prefs2,' HeaderFontname = '||HeaderName)
 zzz=WriteLn(Prefs2,' HeaderFontsize = '||HeaderSize)
 zzz=WriteLn(Prefs2,' HeaderFonttype = '||HeaderType)
 zzz=WriteLn(Prefs2,' HeaderEmboss   = '||HeaderEmbossDirection)
 zzz=WriteLn(Prefs2,' HeaderEmbAmnt  = '||HeaderEmbossAmount)
 zzz=WriteLn(Prefs2,' HeaderTxtstyle = '||HeaderStyle)
 zzz=WriteLn(Prefs2,' HeaderOffset   = '||HeaderOffset)
 zzz=WriteLn(Prefs2,' CenterHeader   = '||CenterHeader)
 zzz=WriteLn(Prefs2,' HeaderR        = '||HeaderR)
 zzz=WriteLn(Prefs2,' HeaderG        = '||HeaderG)
 zzz=WriteLn(Prefs2,' HeaderB        = '||HeaderB)
 zzz=WriteLn(Prefs2,' HeaderString   = '||HeaderString)
 zzz=WriteLn(Prefs2,'')
 zzz=WriteLn(Prefs2,'Other')
 zzz=WriteLn(Prefs2,' DirMode        = '||dirm)
 zzz=WriteLn(Prefs2,' Sorting        = '||sorting)
 zzz=WriteLn(Prefs2,' SaveOnError    = '||SaveOnError)
 zzz=WriteLn(Prefs2,' ProceedOnError = '||ProcOnErr)
 zzz=WriteLn(Prefs2,' ProceedErrStr  = '||ProcOnStr)
 zzz=WriteLn(Prefs2,' StripMode      = '||CharMain||'+'||CharExtension)
 zzz=WriteLn(Prefs2,' TempDir        = '||TDir)
 IF invert=1 THEN Wildcard="~"||Wildcard
 zzz=WriteLn(Prefs2,' Wildcard       = '||Wildcard)
 zzz=WriteLn(Prefs2,' ExamineFiles   = '||ExamineFiles)
 zzz=WriteLn(Prefs2,' ExamineNames   = '||ExamineNames)
 zzz=WriteLn(Prefs2,' ScreenShuffle  = '||Shuffle)
 zzz=WriteLn(Prefs2,'')
 zzz=WriteLn(Prefs2,'Catalogprefs')
 zzz=WriteLn(Prefs2,' CatalogBase    = '||CatBasis)
 zzz=WriteLn(Prefs2,' SFormat-String = '||CatForm)
 zzz=WriteLn(Prefs2,' AddSaverString = '||AddSaver)
 zzz=WriteLn(Prefs2,' SaveMode       = '||CatMode)
 zzz=WriteLn(Prefs2,' RawMode        = '||Mode)
 zzz=WriteLn(Prefs2,' SizeMode       = '||SizeMode)
 zzz=WriteLn(Prefs2,' Colors         = '||Cols)
 zzz=WriteLn(Prefs2,' CatalogWidth   = '||PWI)
 zzz=WriteLn(Prefs2,' CatalogHeight  = '||PHEBack)
 zzz=WriteLn(Prefs2,' X-Tiles        = '||TWI)
 zzz=WriteLn(Prefs2,' Y-Tiles        = '||THI)
 zzz=WriteLn(Prefs2,' TileMode       = '||TMode)
 zzz=WriteLn(Prefs2,' BorderR        = '||BorderR)
 zzz=WriteLn(Prefs2,' BorderG        = '||BorderG)
 zzz=WriteLn(Prefs2,' BorderB        = '||BorderB)
 zzz=WriteLn(Prefs2,' Mixing         = '||MixFactor)
 zzz=WriteLn(Prefs2,' MixR           = '||MixR)
 zzz=WriteLn(Prefs2,' MixG           = '||MixG)
 zzz=WriteLn(Prefs2,' MixB           = '||MixB)
 zzz=WriteLn(Prefs2,' Background1R   = '||Back1R)
 zzz=WriteLn(Prefs2,' Background1G   = '||Back1G)
 zzz=WriteLn(Prefs2,' Background1B   = '||Back1B)
 zzz=WriteLn(Prefs2,' Background2R   = '||Back2R)
 zzz=WriteLn(Prefs2,' Background2G   = '||Back2G)
 zzz=WriteLn(Prefs2,' Background2B   = '||Back2B)
 zzz=WriteLn(Prefs2,' Background3R   = '||Back3R)
 zzz=WriteLn(Prefs2,' Background3G   = '||Back3G)
 zzz=WriteLn(Prefs2,' Background3B   = '||Back3B)
 zzz=WriteLn(Prefs2,' Background4R   = '||Back4R)
 zzz=WriteLn(Prefs2,' Background4G   = '||Back4G)
 zzz=WriteLn(Prefs2,' Background4B   = '||Back4B)
 zzz=WriteLn(Prefs2,' Back2Pos       = '||Back2Pos)
 zzz=WriteLn(Prefs2,' BackDirection  = '||BackDir)
 zzz=WriteLn(Prefs2,'')
 zzz=WriteLn(Prefs2,'Rerenderprefs')
 zzz=WriteLn(Prefs2,' MakeAlternate  = '||MakeAlt)
 zzz=WriteLn(Prefs2,' RenderedColors = '||Colors)
 zzz=WriteLn(Prefs2,' SFormat-String = '||SForm)
 zzz=WriteLn(Prefs2,' SaveMode       = '||SMode)
 zzz=WriteLn(Prefs2,' Extension      = '||Extension)
 zzz=CLOSE(Prefs2)
END
LFORMAT OldLoader
SFORMAT OldSaver
IF DelList.0>0 THEN DO
 DO i=1 TO DelList.0
  ADDRESS COMMAND "Delete <>NIL:" DelList.i
 END
END
IF PPList.0>0 THEN DO
 DO i=1 TO PPList.0
  ADDRESS COMMAND "PPack <>NIL:" PPList.i "nosuffix noper"
 END
END
IF WindowOpen THEN zzz=Delay(150)
IF WeLaunched=1 THEN "ADPRO_EXIT"
EXIT

BREAK_C:                                  /* Interrupts */
 CALL ERR('CatMake terminated by user')
 IF WeLaunched=1 THEN "ADPRO_EXIT"
EXIT
BREAK_D:
 CALL ERR('CatMake terminated by user')
 IF WeLaunched=1 THEN "ADPRO_EXIT"
EXIT
SYNTAX:
 CALL ERR('Syntax Error '||RC||' in line '||SIGL||' !'||NL||ERRORTEXT(RC))
 IF WeLaunched=1 THEN "ADPRO_EXIT"
EXIT

ERR:
PARSE ARG String
  IF String~='' THEN OKAY1 String
  IF SaveOnError='YES' THEN SIGNAL SaveData
  ADDRESS COMMAND 'C:Delete >NIL: '||TDir||'CAT.#?'
  IF WeLaunched=1 THEN "ADPRO_EXIT"
  EXIT 20
RETURN

QueryTiling:
 GETNUMBER "'X-Tiling? "||fl.count||" pics'" 3 1 64
 if rc~=0 then do
  exit 20
 end
 TWI=ADPro_Result
 GETNUMBER "'Y-Tiling? "||fl.count||" pics'" 3 1 64
 if rc~=0 then do
  exit 20
 end
 THI=ADPro_Result
RETURN

UnPack: PROCEDURE EXPOSE DelList. PPList. TDir
PARSE ARG Mode,File,Path
 SELECT
  WHEN Mode="LHA" THEN DO                 /* Extract first file form archive */
   SAY "Unpacking LHA : "||File
   ADDRESS COMMAND "LHA >"||TDir||"CatMakeTemp lq "||File
   IF rc~=0 THEN RETURN File
   IF ~OPEN(In,TDir||"CatMakeTemp","R") THEN RETURN File
   DO i=1 TO 4
    erg=READLN(In)
   END
   rc=CLOSE(In)
   ADDRESS COMMAND "Delete <>NIL: "||TDir||"CatMakeTemp"
   ADDRESS COMMAND "LHA -q e" File erg Path
   File=erg
   i=DelList.0+1
   DelList.i=Path||File
   DelList.0=i
  END
  WHEN Mode="PP" THEN DO                  /* Decrunch PP-File */
   SAY "Unpacking PP  : "||File
   ADDRESS COMMAND "ppack <>NIL:" File "decrunch noper"
   IF rc~=0 THEN RETURN File
   i=PPList.0+1
   PPList.i=File
   PPList.0=i
  END
  OTHERWISE NOP
 END
RETURN File

ExamineFile: PROCEDURE
PARSE ARG Filename
 IF ~OPEN(File,Filename,"R") THEN RETURN 0
 erg=READCH(File,5)
 SELECT
  WHEN RIGHT(erg,3)="-lh" THEN erg="LHA"
  WHEN erg=X2C("5050323009") THEN erg="PP"
  OTHERWISE NOP
 END
 Filename=CLOSE(File)
RETURN Erg

SetDefs:
 PrefsVersion=NeedVersion
 TextRender="YES"
 StripExt="YES"
 FName="Helvetica"
 FSize=11
 FType="BITMAPPED"
 TextR=255
 TextG=255
 TextB=155
 Sizing="RIGHT"
 F2Name="Helvetica"
 F2Size=9
 F2Type="BITMAPPED"
 SizeR=200
 SizeG=200
 SizeB=200
 Seperate="YES"
 AddHeader="YES"
 HeaderName="Helvetica"
 HeaderSize=13
 HeaderType="BITMAPPED"
 HeaderEmbossDirection="OUT"
 HeaderEmbossAmount=100
 HeaderStyle=0
 HeaderOffset=1
 CenterHeader="YES"
 HeaderR=175
 HeaderG=175
 HeaderB=160
 HeaderString="Created with CatMake, © by R.Adolph"
 IF ~Arguments THEN dirm="WHOLE"
 Sorting="ALPHA"
 SaveOnError="YES"
 ProcOnErr="YES"
 ProcOnStr="Corrupted!"
 CharStripping="8+3"
 TDir="T:"
 WildCard="*"
 ExamineFiles="NO"
 ExamineNames="NO"
 Shuffle="NO"
 CatBasis="_Catalog."
 CatForm="IFF"
 AddSaver="YES"
 CatMode="IMAGE"
 Mode="COLOR"
 SizeMode="RELATIVE"
 Cols=256
 PWI=640
 PHE=480
 PHEBack=480
 TWI=4
 THI=4
 TMode="3x3"
 BorderR=255
 BorderG=255
 BorderB=255
 MixFactor=40
 MixR=0
 MixG=0
 MixB=0
 Back1R=0
 Back1G=0
 Back1B=0
 Back2R=0
 Back2G=0
 Back2B=0
 Back3R=0
 Back3G=0
 Back3B=0
 Back4R=0
 Back4G=0
 Back4B=0
 Back2Pos=50
 BackDir="S"
 MakeAlt="NO"
 Colors=256
 SForm="JPEG"
 SMode="RAW"
 Extension="jpg"
CALL Main

AskSettings:
 /* Dirscanning or (Multi-)Select ? */
 IF dirm="WHOLE" THEN DO
                       OKS="Manual"
                       OKS2="MULTI"
                       CANS="Whole"
                       CANS2="WHOLE"
                      END
                 ELSE DO
                       OKS="Whole"
                       OKS2="WHOLE"
                       CANS="Manual"
                       CANS2="MULTI"
                      END
 OKAY2 '"   Do you want to handle a'||NL||'      whole directory?'||NL||'OK='||OKS||'      Cancel='||CANS||'"'
 if rc=0 then dirm=CANS2
         else dirm=OKS2

 /* Save-Format for catalogs */
 IF Up2Date THEN DO
  ListView '"Saver for Catalogs ?"' 10 ITEMS '"'||CatForm||'" '||SaverList
  IF rc>1 THEN CALL ERR('')
  PARSE VAR adpro_result '"' CatForm '"' .  /* Get selected entry */
 END
 ELSE DO
  GETSTRING '"Catalog SFORMAT-String ?"' CatForm
           if rc~=0 then CALL ERR('')
           CatForm=ADPro_Result
 END

 /* Check if the user actually may choose between RAW & IMAGE or not */
 CatModeBak=CatMode
 CatMode=''
 IF INDEX('GIF',UPPER(CatForm))~=0 THEN CatMode='IMAGE'
 IF INDEX('JPEG QRT RENDITION SCULPT',UPPER(CatForm))~=0 THEN CatMode='RAW'

 /* If user may decide,then ask him now */
 IF CatMode='' THEN DO
 IF CatModeBak="RAW" THEN DO
                           OKS="IMAGE"
                           OKS2="IMAGE"
                           CANS="RAW"
                           CANS2="RAW"
                          END
                     ELSE DO
                           OKS="RAW "
                           OKS2="RAW"
                           CANS="IMAGE"
                           CANS2="IMAGE"
                          END
  OKAY2 'What type of File is that type ?'||NL||'OK='||OKS||'     or      Cancel='||CANS
  IF rc=0 THEN CatMode=CANS2
          ELSE CatMode=OKS2
 END

 /* Scaling-Mode */
 IF SizeMode="RELATIVE" THEN DO
                           OKS="Fit   "
                           OKS2="ABSOLUTE"
                           CANS="Aspect"
                           CANS2="RELATIVE"
                          END
                     ELSE DO
                           OKS="Aspect"
                           OKS2="RELATIVE"
                           CANS="Fit"
                           CANS2="ABSOLUTE"
                          END
 OKAY2 '" Shall the images be sized to'||NL||'fit each tile completely or to'||NL||'  be sized aspect-correctly?'||NL||'OK='||OKS||'    or  Cancel='||CANS||'"'
 IF rc=0 THEN SizeMode=CANS2
         ELSE SizeMode=OKS2

 /* Size of catalogs */
 GETNUMBER '"Width of Catalogs ?"' PWI 20 9999
          IF rc~=0 then CALL ERR('')
          PWI=ADPro_Result
 GETNUMBER '"Height of Catalogs ?"' PHE 20 9999
          IF rc~=0 THEN CALL ERR('')
          PHE=ADPro_Result
          PHEBack=PHE

 /* Color-Mode */
 IF mode="COLOR" THEN DO
                       OKS="BW   "
                       OKS2="BLACKWHITE"
                       CANS="Color"
                       CANS2="COLOR"
                      END
                 ELSE DO
                       OKS="Color"
                       OKS2="COLOR"
                       CANS="BW"
                       CANS2="BLACKWHITE"
                      END
 OKAY2 'Make Color or Black&White'||NL||'    Catalog-Picture?'||NL||'OK='||OKS||'        Cancel='||CANS
 IF rc=0 THEN mode=CANS2
         ELSE mode=OKS2

 /* If not truecolor,then ask now for number of colors/color-mode */
 IF CatMode='IMAGE' THEN DO
  IF Up2Date THEN DO
   ListView '"Number of Colors"' 10 ITEMS '"'||Cols||'" '||ColorList
   IF rc>1 THEN CALL ERR('')
   PARSE VAR adpro_result '"' Cols '"' .
  END
  ELSE DO
   GETSTRING "'How many Colors? (2-256,HAM8,CUST...)'" Cols
   IF rc~=0 THEN CALL ERR('')
   Cols=ADPro_Result
  END
 END
 ELSE DO
  IF mode="BLACKWHITE" THEN Cols=8BitGrey
                       ELSE Cols=24Bit
 END

 /* Headerstring-Queries */
 OKAY2 'Add a headerstring to each catalog?'
 IF rc=0 THEN AddHeader='NO'
         ELSE DO
  AddHeader='YES'
  IF LEFT(HeaderString,1)='"' THEN Lef=''
                              ELSE Lef='"'
  IF RIGHT(HeaderString,1)='"' THEN Rig=''
                               ELSE Rig='"'
  GETSTRING '"Enter headerstring"' Lef||HeaderString||Rig
  IF rc~=0 THEN CALL ERR('')
  HeaderString=ADPro_Result
  OKAY2 'Center headerstring horizontally?'
  IF rc=0 THEN DO
                CenterHeader='NO'
                GETNUMBER '"X-Offset in Pixels?"' 1 1 9999
                          IF rc~=0 then CALL ERR('')
                          HeaderOffset=ADPro_Result
               END
          ELSE CenterHeader='YES'
 END

 /* (Re-)Render ? */
 IF MakeAlt="NO" THEN DO
                       OKS="Yes"
                       OKS2="YES"
                       CANS="No"
                       CANS2="NO"
                      END
                 ELSE DO
                       OKS="No "
                       OKS2="NO"
                       CANS="Yes"
                       CANS2="YES"
                      END
 OKAY2 'Do you want to also save'||NL||' as alternate Images ?'||NL||'(Under diff. filenames)'||NL||'OK='||OKS||'         Cancel='||CANS
 IF rc=0 THEN MakeAlt=CANS2
         ELSE DO
          /* Yes,please...*/
          MakeAlt=OKS2

          /* Ask several things...as above */
          IF Extension~=SForm THEN FFlag=1
                              ELSE FFlag=0

          IF Up2Date THEN DO
           ListView '"Saver for Images?"' 10 ITEMS '"'||SForm||'" '||SaverList
           IF rc>1 THEN CALL ERR('')
           PARSE VAR adpro_result '"' SForm '"' .
          END
          ELSE DO
           GETSTRING '"Catalog SFORMAT-String ?"' SForm
           IF rc~=0 THEN CALL ERR('')
           SForm=ADPro_Result
          END

          SModeBak=SMode
          SMode=''
          IF INDEX('GIF',UPPER(SForm))~=0 THEN SMode='IMAGE'
          IF INDEX('JPEG QRT RENDITION SCULPT',UPPER(SForm))~=0 THEN SMode='RAW'

          IF SMode='' THEN DO
           IF SModeBak="RAW" THEN DO
                                   OKS="IMAGE"
                                   OKS2="IMAGE"
                                   CANS="RAW"
                                   CANS2="RAW"
                                  END
                             ELSE DO
                                   OKS="RAW "
                                   OKS2="RAW"
                                   CANS="IMAGE"
                                   CANS2="IMAGE"
                                  END
           OKAY2 'What type of File is that type ?'||NL||'OK='||OKS||'     or      Cancel='||CANS
           IF rc=0 THEN SMode=CANS2
                   ELSE SMode=OKS2
          END

          IF SMode="IMAGE" THEN DO
           IF Up2Date THEN DO
            ListView '"Number of Colors"' 10 ITEMS '"'||Colors||'" '||ColorList
            IF rc>1 THEN CALL ERR('')
            PARSE VAR adpro_result '"' Colors '"' .
           END
           ELSE DO
            GETSTRING "'How many Colors? (2-256,HAM8,CUST...)'" Colors
            IF rc~=0 THEN CALL ERR('')
            Colors=ADPro_Result
           END
          END
          ELSE Colors=24Bit

          IF FFlag=1 THEN FFlag=Extension
                     ELSE FFlag=SForm
          GETSTRING '"Extension WITHOUT >.< ?"' FFlag
          IF rc~=0 THEN CALL ERR('')
          Extension=ADPro_Result
         END
RETURN